Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/GRAPHICS/TS32/COLORPAN.PAS

Pascal/Delphi Source File | 1996-03-16 | 13KB | 413 lines

(***************************************************
TColorPanel->TCustomPanel

A panel that uses a palette handle provided by a
TColorPalette to render itself in 256 colors.

Properties

BlackOutline
  Determines whether a single pixel, black outline will surround the control.
ColorIndex
  The palette index of the panel's color.
ColorIndexFont
  The palette index of the panel's font color.
ColorIndexFontDisabled
  The palette index of the panel's font color when disabled.
ColorIndexFontRollover
  The palette index of the panel's font color when the mouse is moved over
  the control (if Rollover is TRUE).
ColorIndexHilight
  The palette index of the panel's highlight border color.
ColorIndexShadow
  The palette index of the panel's shadow border color.
ColorPalette
  The TColorPalette component that this panel will use.
Rollover
  Whether or not the panel supports a "rollover" effect when the mouse is
  moved over it.

Procedures

ColorPanelActivate
  The form should call this procedure in its OnActivate handler.  It makes
  sure that all TColorPanels are properly rendered.

ColorPanelMouseMove
  Controls should call this procedure in their OnMouseMove handler.  It handles
  the rollover effect when moving off of TColorPanels.
***************************************************)

unit ColorPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ColorPalette, DsgnIntf;

type

  TColorPanel = class( TCustomPanel )
  private
     FBlackOutline: boolean;
     FColorIndex: byte;
     FColorIndexFont: byte;
     FColorIndexFontDisabled: byte;
     FColorIndexFontRollover: byte;
     FColorIndexHilight: byte;
     FColorIndexShadow: byte;
     FColorPalette: TColorPalette;
     FRollover: boolean;
     FMouseOver: boolean;
  protected
     procedure Notification( AComponent: TComponent; Operation: TOperation ); override;
     procedure MouseMove( Shift: TShiftState; X, Y: Integer ); override;
     procedure Paint; override;
     procedure SetBlackOutline( b: boolean );
     procedure SetColorIndex( n: byte );
     procedure SetColorIndexFont( n: byte );
     procedure SetColorIndexFontDisabled( n: byte );
     procedure SetColorIndexHilight( n: byte );
     procedure SetColorIndexShadow( n: byte );
     procedure SetColorPalette( cp: TColorPalette );
     procedure SetMouseOver( b: boolean );
     procedure CMEnabledChanged( var Message: TMessage ); message CM_ENABLEDCHANGED;
     property MouseOver: boolean read FMouseOver write SetMouseOver;
  public
     constructor Create( AOwner: TComponent ); override;
  published
     property Align;
     property Alignment;
     property BevelOuter;
     property BevelWidth;
     property Caption;
     property DragCursor;
     property DragMode;
     property Enabled;
     property Font;
     property ParentShowHint;
     property PopupMenu;
     property ShowHint;
     property Visible;
     property BlackOutline: boolean read FBlackOutline write SetBlackOutline default TRUE;
     property ColorIndex: byte read FColorIndex write SetColorIndex;
     property ColorIndexFont: byte read FColorIndexFont write SetColorIndexFont;
     property ColorIndexFontDisabled: byte read FColorIndexFontDisabled write SetColorIndexFontDisabled;
     property ColorIndexFontRollover: byte read FColorIndexFontRollover write FColorIndexFontRollover;
     property ColorIndexHilight: byte read FColorIndexHilight write SetColorIndexHilight;
     property ColorIndexShadow: byte read FColorIndexShadow write SetColorIndexShadow;
     property ColorPalette: TColorPalette read FColorPalette write SetColorPalette;
     property Rollover: boolean read FRollover write FRollover default FALSE;
     property OnClick;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDrag;
     property OnEnter;
     property OnExit;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnResize;
     property OnStartDrag;
  end;

  TColorIndexEditor = class( TIntegerProperty )
  private
  protected
  public
     procedure Edit; override;
     function GetAttributes: TPropertyAttributes; override;
  end;

procedure ColorPanelMouseMove;
procedure ColorPanelActivate( frm: TForm );
procedure Register;

var
  panelLastRolled: TColorPanel;

implementation

uses
  ColorIndexEditor;

(***************************************************
OnActivate of the Form should call this procedure,
which makes sure all color panels are properly rendered.
***************************************************)
procedure ColorPanelActivate( frm: TForm );
var
  i: integer;
begin
  for i := 0 to frm.ComponentCount - 1 do
     if frm.Components[i] is TColorPanel then
        with frm.Components[i] as TColorPanel do
           begin
              if Visible then
                 Refresh;
           end;
end;

(***************************************************
The other controls of the form should call this method
on their MouseMove events to ensure that the rollover
is properly terminated.
**************************************************)
procedure ColorPanelMouseMove;
begin
  if panelLastRolled <> nil then
     panelLastRolled.MouseOver := FALSE;
end;


(***************************************************
Set some defaults
***************************************************)
constructor TColorPanel.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  FBlackOutline := TRUE;
  FMouseOver := FALSE;
  FRollover := FALSE;
end;

(***************************************************
Paint by using the specified color indices
***************************************************)
procedure TColorPanel.Paint;
var
  nColor1, nColor2: byte;
  nBlackOffset: integer;
  rectDraw: TRect;
  nFlags: integer;
begin
  if Assigned( FColorPalette ) then
     begin
        SelectPalette( Canvas.Handle, FColorPalette.Palette, FALSE );
        RealizePalette( Canvas.Handle );
        Canvas.Brush.Style := bsSolid;
        Canvas.Brush.Color := PaletteIndex( FColorIndex );
        Canvas.FillRect( Canvas.ClipRect );

{ Determine which colors to use for left/upper and right/lower edges }
        if BevelOuter = bvRaised then
           begin
              nColor1 := FColorIndexHilight;
              nColor2 := FColorIndexShadow;
           end
        else
           begin
              nColor1 := FColorIndexShadow;
              nColor2 := FColorIndexHilight;
           end;

{ If the black border is drawm, offset all coords by 1 pixel }
        if FBlackOutline then
           nBlackOffset := 1
        else
           nBlackOffset := 0;

{ Draw the hilight }
        Canvas.Pen.Style := psSolid;
        Canvas.Pen.Width := BevelWidth * 2;
        Canvas.Pen.Color := PaletteIndex( nColor1 );
        Canvas.MoveTo( nBlackOffset, Height - 1 - nBlackOffset );
        Canvas.LineTo( nBlackOffset, nBlackOffset );
        Canvas.LineTo( Width - 1 + 1 - nBlackOffset, nBlackOffset );

{ Draw the shadow }
        Canvas.Pen.Color := PaletteIndex( nColor2 );
        Canvas.LineTo( Width - 1 + 1 - nBlackOffset, Height - 1 + 1 - nBlackOffset );
        Canvas.LineTo( nBlackOffset, Height - 1 + 1 - nBlackOffset );

{ Draw the black border }
        if FBlackOutline then
           begin
              Canvas.Brush.Style := bsClear;
              Canvas.Pen.Color := PaletteIndex( 0 );
              Canvas.Pen.Width := 1;
              Canvas.Rectangle( 0, 0, Width - 1, Height  - 1 );
           end;

{ Draw the caption aligned within the client rectangle }
        if Caption <> '' then
           begin
              case Alignment of
                 taCenter:
                    nFlags := DT_SINGLELINE or DT_VCENTER or DT_CENTER;
                 taLeftJustify:
                    nFlags := DT_SINGLELINE or DT_VCENTER or DT_LEFT;
                 taRightJustify:
                    nFlags := DT_SINGLELINE or DT_VCENTER or DT_RIGHT;
              end;

              Canvas.Font.Assign( Font );

              if not Enabled then
                 Canvas.Font.Color := PaletteIndex( FColorIndexFontDisabled )
              else if MouseOver and Rollover then
                 Canvas.Font.Color := PaletteIndex( FColorIndexFontRollover )
              else
                 Canvas.Font.Color := PaletteIndex( FColorIndexFont );

              rectDraw := ClientRect;
              Canvas.Brush.Style := bsClear;

              if BevelOuter = bvLowered then
                 OffsetRect( rectDraw, BevelWidth, BevelWidth );

              DrawText( Canvas.Handle, PChar( Caption ), Length( Caption ), rectDraw, nFlags );
           end;

     end
  else
     inherited Paint;
end;

(***************************************************
When color properties change, refresh the control.
***************************************************)
procedure TColorPanel.SetBlackOutline( b: boolean );
begin
  if FBlackOutline <> b then
     begin
        FBlackOutline := b;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorIndex( n: byte );
begin
  if FColorIndex <> n then
     begin
        FColorIndex := n;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorIndexFont( n: byte );
begin
  if FColorIndexFont <> n then
     begin
        if FColorIndexFontRollover = 0 then
           FColorIndexFontRollover := n;
        FColorIndexFont := n;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorIndexFontDisabled( n: byte );
begin
  if FColorIndexFontDisabled <> n then
     begin
        FColorIndexFontDisabled := n;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorIndexHilight( n: byte );
begin
  if FColorIndexHilight <> n then
     begin
        FColorIndexHilight := n;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorIndexShadow( n: byte );
begin
  if FColorIndexShadow <> n then
     begin
        FColorIndexShadow := n;
        Refresh;
     end;
end;

procedure TColorPanel.SetColorPalette( cp: TColorPalette );
begin
  FColorPalette := cp;
  Refresh;
end;

procedure TColorPanel.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Refresh;
end;

(***************************************************
If the color panel is deleted, set property to nil.
***************************************************)
procedure TColorPanel.Notification( AComponent: TComponent; Operation: TOperation );
begin
  if AComponent = FColorPalette then
     if Operation = opRemove then
        ColorPalette := nil;
end;

(***************************************************
Handle Rollover effect on MouseMove
***************************************************)
procedure TColorPanel.MouseMove( Shift: TShiftState; X, Y: Integer );
begin
  inherited MouseMove( Shift, X, Y );
  if panelLastRolled <> nil then
     if panelLastRolled <> self then
        panelLastRolled.MouseOver := FALSE;
  MouseOver := TRUE;
  panelLastRolled := self;
end;

procedure TColorPanel.SetMouseOver( b: boolean );
begin
  if FMouseOver <> b then
     begin
        FMouseOver := b;
        if Rollover then
           Refresh;
     end;
end;

(*********************************************
Property editors.
*********************************************)
procedure TColorIndexEditor.Edit;
var
  cpSelf: TColorPalette;
begin
  cpSelf := TColorPalette( TColorPanel( GetComponent( 0 ) ).ColorPalette );
  if cpSelf = nil then
     begin
        ShowMessage( 'First assign a TColorPalette to the ColorPalette property' );
        Exit;
     end;
  with TfrmColorIndexEditor.Create( nil ) do
     begin
        pal := cpSelf;
        nIndex := GetOrdValue;
        if ShowModal = mrOk then
           SetOrdValue( nIndex );
        Release;
     end;
end;

function TColorIndexEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

procedure Register;
begin
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndex', TColorIndexEditor );
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFont', TColorIndexEditor );
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFontDisabled', TColorIndexEditor );
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFontRollover', TColorIndexEditor );
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexHilight', TColorIndexEditor );
  RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexShadow', TColorIndexEditor );
  RegisterComponents( 'Vis', [TColorPanel] );
end;

end.